home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Atari Mega Archive 1
/
Atari Mega Archive - Volume 1.iso
/
cli
/
gulamdoc.arc
/
TEXINFMT.EL
< prev
Wrap
Lisp/Scheme
|
1987-11-02
|
30KB
|
861 lines
;; Convert texinfo files to info files.
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
(defvar texinfo-format-syntax-table nil)
(defvar texinfo-vindex)
(defvar texinfo-findex)
(defvar texinfo-cindex)
(defvar texinfo-pindex)
(defvar texinfo-tindex)
(defvar texinfo-kindex)
(defvar texinfo-last-node)
(defvar texinfo-node-names)
(if texinfo-format-syntax-table
nil
(setq texinfo-format-syntax-table (make-syntax-table))
(modify-syntax-entry ?\" " " texinfo-format-syntax-table)
(modify-syntax-entry ?\\ " " texinfo-format-syntax-table)
(modify-syntax-entry ?@ "\\" texinfo-format-syntax-table)
(modify-syntax-entry ?\^q "\\" texinfo-format-syntax-table)
(modify-syntax-entry ?\[ "." texinfo-format-syntax-table)
(modify-syntax-entry ?\] "." texinfo-format-syntax-table)
(modify-syntax-entry ?\( "." texinfo-format-syntax-table)
(modify-syntax-entry ?\) "." texinfo-format-syntax-table)
(modify-syntax-entry ?{ "(}" texinfo-format-syntax-table)
(modify-syntax-entry ?} "){" texinfo-format-syntax-table)
(modify-syntax-entry ?\' "." texinfo-format-syntax-table))
(defun texinfo-format-buffer (&optional notagify)
"Process the current buffer as texinfo code, into an Info file.
The Info file output is generated in a buffer
visiting the Info file names specified in the @setfilename command.
Non-nil argument (prefix, if interactive) means don't make tag table
and don't split the file if large. You can use Info-tagify and
Info-split to do these manually."
(interactive "P")
(let ((lastmessage "Formatting Info file..."))
(message lastmessage)
(texinfo-format-buffer-1)
(if notagify
nil
(if (> (buffer-size) 30000)
(progn
(message (setq lastmessage "Making tags table for Info file..."))
(Info-tagify)))
(if (> (buffer-size) 100000)
(progn
(message (setq lastmessage "Splitting Info file..."))
(Info-split))))
(message (concat lastmessage
(if (interactive-p) "done. Now save it." "done.")))))
(defun texinfo-format-buffer-1 ()
(let (texinfo-format-filename
texinfo-example-start
texinfo-command-start
texinfo-command-end
texinfo-command-name
texinfo-last-node
texinfo-vindex
texinfo-findex
texinfo-cindex
texinfo-pindex
texinfo-tindex
texinfo-kindex
texinfo-stack
texinfo-node-names
outfile
(fill-column fill-column)
(input-buffer (current-buffer))
(input-directory default-directory))
(save-excursion
(goto-char (point-min))
(search-forward "@setfilename")
(setq texinfo-command-end (point))
(setq outfile (texinfo-parse-line-arg)))
(find-file outfile)
(texinfo-mode)
(set-syntax-table texinfo-format-syntax-table)
(erase-buffer)
(insert-buffer-substring input-buffer)
(goto-char (point-min))
(search-forward "@setfilename")
(beginning-of-line)
(delete-region (point-min) (point))
(while (search-forward "``" nil t)
(replace-match "\""))
(goto-char (point-min))
(while (search-forward "''" nil t)
(replace-match "\""))
(goto-char (point-min))
(while (search-forward "@" nil t)
;; If the @ is preceded by an odd number of ^Q's, do nothing,
(if (and (eq (char-after (- (point) 2)) ?\^Q)
(save-excursion
(forward-char -1)
(let ((opoint (point)))
(skip-chars-backward "\^Q")
(= (logand 1 (- opoint (point))) 1))))
nil
(if (looking-at "[@{}'` *]")
(if (= (following-char) ?*)
(delete-region (1- (point)) (1+ (point)))
(delete-char -1)
(forward-char 1))
(setq texinfo-command-start (1- (point)))
(if (= (char-syntax (following-char)) ?w)
(forward-word 1)
(forward-char 1))
(setq texinfo-command-end (point))
(setq texinfo-command-name
(intern (buffer-substring (1+ texinfo-command-start)
texinfo-command-end)))
(let ((cmd (get texinfo-command-name 'texinfo-format)))
(if cmd (funcall cmd)
(texinfo-unsupported))))))
(cond (texinfo-stack
(goto-char (nth 2 (car texinfo-stack)))
(error "Unterminated @%s" (car (car texinfo-stack)))))
(goto-char (point-min))
(while (search-forward "\^q" nil t)
(delete-char -1)
(forward-char 1))
(goto-char (point-min))
(list outfile
texinfo-vindex texinfo-findex texinfo-cindex
texinfo-pindex texinfo-tindex texinfo-kindex)))
(put 'begin 'texinfo-format 'texinfo-format-begin)
(defun texinfo-format-begin ()
(texinfo-format-begin-end 'texinfo-format))
(put 'begin 'texinfo-format 'texinfo-format-begin)
(defun texinfo-format-begin ()
(texinfo-format-begin-end 'texinfo-format))
(put 'end 'texinfo-format 'texinfo-format-end)
(defun texinfo-format-end ()
(texinfo-format-begin-end 'texinfo-end))
(defun texinfo-format-begin-end (prop)
(setq texinfo-command-name (intern (texinfo-parse-line-arg)))
(setq cmd (get texinfo-command-name prop))
(if cmd (funcall cmd)
(texinfo-unsupported)))
(defun texinfo-parse-line-arg ()
(goto-char texinfo-command-end)
(let ((start (point)))
(cond ((looking-at " ")
(skip-chars-forward " ")
(setq start (point))
(end-of-line)
(setq texinfo-command-end (1+ (point))))
((looking-at "{")
(setq start (1+ (point)))
(forward-list 1)
(setq texinfo-command-end (point))
(forward-char -1))
(t
(error "Invalid texinfo command arg format")))
(prog1 (buffer-substring start (point))
(if (eolp) (forward-char 1)))))
(defun texinfo-parse-arg-discard ()
(prog1 (texinfo-parse-line-arg)
(texinfo-discard-command)))
(defun texinfo-discard-command ()
(delete-region texinfo-command-start texinfo-command-end))
(defun texinfo-format-parse-line-args ()
(let ((start (1- (point)))
next beg end
args)
(skip-chars-forward " ")
(while (not (eolp))
(setq beg (point))
(re-search-forward "[\n,]")
(setq next (point))
(if (bolp) (setq next (1- next)))
(forward-char -1)
(skip-chars-backward " ")
(setq end (point))
(setq args (cons (if (> end beg) (buffer-substring beg end))
args))
(goto-char next)
(skip-chars-forward " "))
(if (eolp) (forward-char 1))
(setq texinfo-command-end (point))
(nreverse args)))
(defun texinfo-format-parse-args ()
(let ((start (1- (point)))
next beg end
args)
(search-forward "{")
(while (/= (preceding-char) ?\})
(skip-chars-forward " \t\n")
(setq beg (point))
(re-search-forward "[},]")
(setq next (point))
(forward-char -1)
(skip-chars-backward " \t\n")
(setq end (point))
(cond ((< beg end)
(goto-char beg)
(while (search-forward "\n" end t)
(replace-match " "))))
(setq args (cons (if (> end beg) (buffer-substring beg end))
args))
(goto-char next))
(if (eolp) (forward-char 1))
(setq texinfo-command-end (point))
(nreverse args)))
(put 'setfilename 'texinfo-format 'texinfo-format-setfilename)
(defun texinfo-format-setfilename ()
(let ((arg (texinfo-parse-arg-discard)))
(setq texinfo-format-filename (file-name-nondirectory arg))
(insert "Info file "